#read from original IPUMS
stfips<-data.frame(stfip=unique(tidycensus::fips_codes$state_code), stname=unique(tidycensus::fips_codes$state_name))
head(stfips)
head(unique(cpsdat2$STATEFIP))
cpsdat2$stfip<-sprintf("%02d",cpsdat2$STATEFIP)
cpsdat2<-merge(cpsdat2, stfips, by.x="stfip", by.y= "stfip")
# cntpep<-cpsdat2%>%
# group_by(CPSIDP)%>%
# summarise(ntime=n())%>%
# #filter(ntime>1)%>%
# arrange(ntime)
#
# cpsdat2<-merge(cpsdat2, cntpep, by="CPSIDP")
# cpsdat2%>%
# filter(ntime>1)%>%
# select(STATEFIP, YEAR,MISH,MONTH, SERIAL, CPSIDP, AGE, SEX, RACE)%>%
# filter(YEAR>2009, CPSIDP!=0)%>%
# arrange(CPSIDP, MONTH,MISH)%>%
# head(., n=200)
cpsdat2<-cpsdat2%>%
filter(YEAR >2009,AGE>16,EMPSTAT%in%c(10,12,21,22), stname=="Texas")%>%
mutate(emp = Recode(EMPSTAT, recodes = "0 = NA; 1='af'; 10='curr work'; 12 = 'recent no job'; 20:22='unemp'"),
sex=Recode(SEX, recodes = "1='Male'; 2='Female'; else=NA", as.factor=T),
race = Recode (RACE, recodes = "100 = 'White'; 200='Black';300='AIAE';651='Asian';652='NHPI';802:830='multiple'; else=NA"),
lfpart = Recode(LABFORCE,recodes="2=1; 1=0; else=NA" ),
hisp= ifelse(HISPAN !=0, "Latino", "Not Latino")
)%>%
mutate( curremp = ifelse(EMPSTAT%in%c(10,12) , 1, 0),
recentloss=ifelse(emp=='recent no job', 1,0))%>%
arrange(CPSIDP, MONTH,MISH)
cpsdat2$emp_bin<-ifelse(cpsdat2$emp!="curr work", 1, 0)
cpsdat2$month<- as.Date(as.yearmon(paste(cpsdat2$YEAR,cpsdat2$MONTH, sep="/"), format = "%Y/%m"))
cpsdat2$race_eth<-interaction(cpsdat2$race, cpsdat2$hisp)
library(stringr)
cpsdat2$race_eth2<-ifelse(str_sub(as.character(cpsdat2$race_eth), start = -10)=="Not Latino", as.character(cpsdat2$race_eth),"Latino")
#cpsdat2$fb<-ifelse(cpsdat2$CITIZEN%in%c(4,5),"Non-citizen", "Citizen")
#cpsdat2
cpsdat2$byr<-2020-cpsdat2$AGE
cpsdat2$cohort<-car::Recode(cpsdat2$byr, recodes = "1944:1964='boomer'; 1965:1979='genx'; 1980:1994='geny'; 1995:2015='genz'; else=NA")
cpsdat2$educ<-car::Recode(cpsdat2$EDUC, recodes = "21:72='< High School'; 73='High School'; 81:110='Some college'; 111:125='Bachelors +';else=NA; 0=NA", as.factor=T)
cpsdat2$duremp_c<-ifelse(cpsdat2$DURUNEMP==999, NA, cpsdat2$DURUNEMP)
cpsdat2$fb<-ifelse(cpsdat2$YRIMMIG>0, "Foreign Born", "Native Born")
cpsdat2$avghrs<-ifelse(cpsdat2$AHRSWORKT==999, NA, cpsdat2$AHRSWORKT)
cpsdat2<-cpsdat2%>%
select(emp_bin,CPSIDP, MISH, MONTH, WTFINL, month, race_eth2, curremp,educ, sex, race, emp, YEAR, AGE, stname, PANLWT, EDUC, avghrs, ABSENT, WKSTAT, EMPSAME, MULTJOB, NUMJOB,recentloss,fb, cohort , METRO, duremp_c, lfpart)%>%
filter(is.na(race_eth2)==F, month>=as.Date('2019-06-01'))%>%
#filter(AGE>18)%>%
group_by(CPSIDP)%>%
arrange(CPSIDP, MONTH)
#setwd(getwd())
cpsdat2<-readRDS(file = "data/cpsdat_tx.rds")
des<-survey::svydesign(ids=~1, weights = ~WTFINL, data=cpsdat2)
m1<-svyglm(emp_bin~factor(race_eth2)+sex+factor(race_eth2)*factor(month), des, family=binomial)
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
#summary(m1)
anova(m1)
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
## Anova table: (Rao-Scott LRT)
## svyglm(formula = emp_bin ~ factor(race_eth2), design = des, family = binomial)
## stats DEff df ddf p
## factor(race_eth2) 117.863 1.2134 2.0000 36576 < 2.2e-16 ***
## sex 30.446 1.1667 1.0000 36575 3.573e-07 ***
## factor(month) 826.725 1.0900 12.0000 36563 < 2.2e-16 ***
## factor(race_eth2):factor(month) 35.320 1.1457 24.0000 36539 0.1613
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Anova(m1)
## Analysis of Deviance Table (Type II tests)
##
## Response: emp_bin
## Df Chisq Pr(>Chisq)
## factor(race_eth2) 2 103.667 < 2.2e-16 ***
## sex 1 28.001 1.212e-07 ***
## factor(month) 12 715.237 < 2.2e-16 ***
## factor(race_eth2):factor(month) 24 30.585 0.1661
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
m2<-svyglm(emp_bin~race_eth2+sex+race_eth2*sex*factor(month), des, family=binomial)
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
#summary(m2)
Anova(m2)
## Analysis of Deviance Table (Type II tests)
##
## Response: emp_bin
## Df Chisq Pr(>Chisq)
## race_eth2 2 103.980 < 2.2e-16 ***
## sex 1 33.202 8.308e-09 ***
## factor(month) 12 714.742 < 2.2e-16 ***
## race_eth2:sex 2 18.925 7.771e-05 ***
## race_eth2:factor(month) 24 31.399 0.1426
## sex:factor(month) 12 12.302 0.4218
## race_eth2:sex:factor(month) 24 30.684 0.1631
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
m3<-svyglm(emp_bin~race_eth2+sex+race_eth2*sex*fb*factor(month), des, family=binomial)
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
#summary(m3)
Anova(m3)
## Analysis of Deviance Table (Type II tests)
##
## Response: emp_bin
## Df Chisq Pr(>Chisq)
## race_eth2 2 628.1701 < 2.2e-16 ***
## sex 1 44.2958 2.823e-11 ***
## fb 1 1521.4249 < 2.2e-16 ***
## factor(month) 12 2488.9023 < 2.2e-16 ***
## race_eth2:sex 2 9.7032 0.007816 **
## race_eth2:fb 2 800.8177 < 2.2e-16 ***
## sex:fb 1 28.5187 9.280e-08 ***
## race_eth2:factor(month) 24 1610.2749 < 2.2e-16 ***
## sex:factor(month) 12 61.1820 1.373e-08 ***
## fb:factor(month) 12 1958.6548 < 2.2e-16 ***
## race_eth2:sex:fb 2 9.9647 0.006858 **
## race_eth2:sex:factor(month) 24 190.1129 < 2.2e-16 ***
## race_eth2:fb:factor(month) 24 3113.4001 < 2.2e-16 ***
## sex:fb:factor(month) 12 164.9320 < 2.2e-16 ***
## race_eth2:sex:fb:factor(month) 24 587.7741 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
outna<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2 )%>%
summarise(#unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
# avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)))%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2, month )
## `summarise()` regrouping output by 'month' (override with `.groups` argument)
head(outna)
## # A tibble: 6 x 3
## month race_eth2 emprate
## <date> <chr> <dbl>
## 1 2020-01-01 Black.Not Latino 0.0477
## 2 2020-02-01 Black.Not Latino 0.0546
## 3 2020-03-01 Black.Not Latino 0.0780
## 4 2020-04-01 Black.Not Latino 0.192
## 5 2020-05-01 Black.Not Latino 0.219
## 6 2020-06-01 Black.Not Latino 0.135
p<-outna%>%
filter(race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="NHPI.Not Latino", race_eth2!="Asian.Not Latino")%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity",subtitle = "January to June 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+ylim(c(0, .2))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+
scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.
#p$labels$colour<-"Race/Ethnicity"
#p
ggsave( filename = "images/tx_unemp.png",height=8, width=10, dpi = "print" )
fig1<-ggplotly(p)
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
fig1
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2, sex )%>%
summarise(#unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
#avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)))%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2,sex, month )
## `summarise()` regrouping output by 'month', 'race_eth2' (override with `.groups` argument)
head(outna2)
## # A tibble: 6 x 4
## month race_eth2 sex emprate
## <date> <chr> <fct> <dbl>
## 1 2020-01-01 Black.Not Latino Female 0.0359
## 2 2020-02-01 Black.Not Latino Female 0.0298
## 3 2020-03-01 Black.Not Latino Female 0.0713
## 4 2020-04-01 Black.Not Latino Female 0.234
## 5 2020-05-01 Black.Not Latino Female 0.205
## 6 2020-06-01 Black.Not Latino Female 0.121
p2<-outna2%>%
filter(race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="NHPI.Not Latino", race_eth2!="Asian.Not Latino")%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity and Gender",subtitle = "January to June 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+ylim(c(0, .25))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+facet_wrap(~sex)+scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.
#p$labels$colour<-"Race/Ethnicity"
#p
ggplotly(p2)
ggsave(filename = "images/tx_unemp_sex.png",height=8, width=10, dpi = "print" )
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2, educ, sex )%>%
summarise(unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
#avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)))%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2,sex,educ, month )
## `summarise()` regrouping output by 'month', 'race_eth2', 'educ' (override with `.groups` argument)
head(outna2)
## # A tibble: 6 x 6
## month race_eth2 educ sex unemprate emprate
## <date> <chr> <fct> <fct> <dbl> <dbl>
## 1 2020-01-01 Black.Not Latino < High School Female 0 0.0627
## 2 2020-02-01 Black.Not Latino < High School Female 0 0
## 3 2020-03-01 Black.Not Latino < High School Female 0.323 0
## 4 2020-04-01 Black.Not Latino < High School Female 0.200 0.304
## 5 2020-05-01 Black.Not Latino < High School Female 0.114 0.292
## 6 2020-06-01 Black.Not Latino < High School Female 0.131 0.271
library(forcats)
p3<-outna2%>%
filter(race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="NHPI.Not Latino", race_eth2!="Asian.Not Latino", is.na(educ)==F)%>%
mutate(educ=fct_relevel(educ,"< High School","High School","Some college","Bachelors +" ))%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity, Gender and Education",subtitle = "January to June 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+#ylim(c(0, .6))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+facet_wrap(~educ+sex, ncol = 4)+scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
#p$labels$colour<-"Race/Ethnicity"
#p
ggsave(filename = "images/tx_unemp_sex_educ.png",height=8, width=10, dpi = "print" )
ggplotly(p3)
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2, fb )%>%
summarise(#unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
# avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)))%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2,fb, month )
## `summarise()` regrouping output by 'month', 'race_eth2' (override with `.groups` argument)
head(outna2)
## # A tibble: 6 x 4
## month race_eth2 fb emprate
## <date> <chr> <chr> <dbl>
## 1 2020-01-01 Black.Not Latino Foreign Born 0.0447
## 2 2020-02-01 Black.Not Latino Foreign Born 0.0203
## 3 2020-03-01 Black.Not Latino Foreign Born 0
## 4 2020-04-01 Black.Not Latino Foreign Born 0.229
## 5 2020-05-01 Black.Not Latino Foreign Born 0.199
## 6 2020-06-01 Black.Not Latino Foreign Born 0.127
p4<-outna2%>%
mutate(group=paste(race_eth2, fb, sep = "-"))%>%
filter(race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="Asian.Not Latino", race_eth2!="NHPI.Not Latino", group!="AIAE.Not Latino-Non-citizen")%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity and Nativity Status",subtitle = "January to June 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+ylim(c(0, .25))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+facet_wrap(~fb)+scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.
#p$labels$colour<-"Race/Ethnicity"
#p
ggsave(filename = "images/tx_unemp_sex_fb.png",height=8, width=10, dpi = "print" )
ggplotly(p4)
#write.csv(outna2, file="~/Documents/GitHub/unemployment/fig_5rates.csv", row.names = F)
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2, educ, sex )%>%
summarise(unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
#avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)),
nsamp=n())%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2,sex,educ, month )
## `summarise()` regrouping output by 'month', 'race_eth2', 'educ' (override with `.groups` argument)
#write.csv(outna2,file = "~/unemp_to_rogelio.csv", row.names = F)
head(outna2)
## # A tibble: 6 x 7
## month race_eth2 educ sex unemprate emprate nsamp
## <date> <chr> <fct> <fct> <dbl> <dbl> <int>
## 1 2020-01-01 Black.Not Latino < High School Female 0 0.0627 15
## 2 2020-02-01 Black.Not Latino < High School Female 0 0 6
## 3 2020-03-01 Black.Not Latino < High School Female 0.323 0 6
## 4 2020-04-01 Black.Not Latino < High School Female 0.200 0.304 8
## 5 2020-05-01 Black.Not Latino < High School Female 0.114 0.292 5
## 6 2020-06-01 Black.Not Latino < High School Female 0.131 0.271 7
library(forcats)
p6<-outna2%>%
filter(nsamp>30,race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="NHPI.Not Latino", is.na(educ)==F, race_eth2!="Asian.Not Latino", educ !="< High School")%>%
mutate(educ=fct_relevel(educ,"< High School","High School","Some college","Bachelors +" ))%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity, Gender and Education",subtitle = "January to May 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+ylim(c(0, .4))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+facet_wrap(~educ+sex, ncol = 4)+scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.
#p$labels$colour<-"Race/Ethnicity"
#p
#<<<<<<< HEAD
ggsave(filename = "images/tx_unemp_sex_educ.png",height=8, width=10, dpi = "print" )
ggplotly(p6)
#write.csv(outna2, file="~/Documents/GitHub/unemployment/fig_gender_edu.csv", row.names = F)
#>>>>>>> a84ccb9e5b8bcff0b7f9cf5252e05dbf049207d3
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F,month>=as.Date('2020-01-01'))%>%
mutate(Age_Group = cut(AGE, breaks = c(16,24, 34, 44, 54, 64, 86), labels = c("16 to 24", "25 to 34", "35 to 44", "45 to 54", "55 to 64", "65 or older"),include.lowest = T))%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, race_eth2, Age_Group )%>%
summarise(unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
#avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)),
nsamp=n())%>%
arrange( month)%>%
ungroup()%>%
arrange( race_eth2,Age_Group, month )
## `summarise()` regrouping output by 'month', 'race_eth2' (override with `.groups` argument)
#write.csv(outna2,file = "~/unemp_to_rogelio.csv", row.names = F)
head(outna2)
## # A tibble: 6 x 6
## month race_eth2 Age_Group unemprate emprate nsamp
## <date> <chr> <fct> <dbl> <dbl> <int>
## 1 2020-01-01 Black.Not Latino 16 to 24 0.0234 0.0811 33
## 2 2020-02-01 Black.Not Latino 16 to 24 0.0676 0.101 29
## 3 2020-03-01 Black.Not Latino 16 to 24 0.0948 0.114 25
## 4 2020-04-01 Black.Not Latino 16 to 24 0.0843 0.374 33
## 5 2020-05-01 Black.Not Latino 16 to 24 0.0497 0.423 30
## 6 2020-06-01 Black.Not Latino 16 to 24 0.0820 0.253 27
library(forcats)
p7<-outna2%>%
filter(nsamp>25,race_eth2!="multiple.Not Latino",race_eth2!="AIAE.Not Latino", race_eth2!="NHPI.Not Latino", is.na(Age_Group)==F, race_eth2!="Asian.Not Latino")%>%
#mutate(educ=fct_relevel(educ,"< High School","High School","Some college","Bachelors +" ))%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=race_eth2, group=race_eth2), lwd=2)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed in Texas by Race/Ethnicity, and Age Group",subtitle = "January to May 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+#ylim(c(0, .6))+
scale_color_brewer(type="qual", palette = "Set1", name = "Race/Ethnicity",labels=c(" Black", "Latino"," White"))+facet_wrap(~Age_Group, ncol = 3)+scale_y_continuous(limits = c(0, .45),labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
#p$labels$colour<-"Race/Ethnicity"
#p
ggsave(filename = "images/tx_unemp_age.png",height=8, width=10, dpi = "print" )
ggplotly(p7)
#write.csv(outna2, file="~/Documents/GitHub/unemployment/fig_2.csv", row.names = F)
outna2<-cpsdat2%>%
filter(is.na(race_eth2)==F, month>=as.Date('2020-01-01'))%>%
filter(METRO!=0, METRO!=4)%>%
#mutate(Group = ifelse(stname=="Texas", "Texas","Rest of US"))%>%
group_by(month, METRO )%>%
summarise(unemprate =(wtd.mean(recentloss,weights = WTFINL, na.rm=T)),
#avghrs=wtd.mean(AHRSWORKT,weights = WTFINL, na.rm=T),
emprate =(1- wtd.mean(curremp,weights = WTFINL, na.rm=T)),
nsamp=n())%>%
arrange( month)%>%
ungroup()%>%
arrange( METRO, month )
## `summarise()` regrouping output by 'month' (override with `.groups` argument)
p8<-outna2%>%
filter(nsamp>30)%>%
mutate(metro = car::Recode(METRO, recodes = "1='Not Metro';2='Central City'; 3='Outside Central City'"))%>%
ggplot()+geom_line(aes(x=month, y=emprate,color=metro, group=metro), lwd=1.75)+
#scale_fill_discrete(name=)+
labs(title = "Percent Unemployed by Metropolitan Residence",subtitle = "February to June 2020",
caption = "Source: IPUMS CPS Monthly Data \n Calculations by Corey S. Sparks, Ph.D.",
x = "Month",
y = "Percent Unemployed")+#ylim(c(0, .4))+
scale_color_brewer(type="qual", palette = "Set1", name = "Location")+scale_y_continuous(labels = scales::percent)+
#guides(fill=guide_legend(title="Race/Ethnicity"))+
#geom_hline(yintercept = 0, col="red", lwd=1.1)+
theme_minimal()+theme(axis.text.x = element_text(angle = 45))
ggsave(filename = "images/tx_metro.png",height=8, width=10, dpi = "print" )
ggplotly(p8)
test<-sessioninfo::session_info()
knitr::write_bib(test$packages$package, file = "loadedpkgs.bib")
Fox, Weisberg, and Price (2020) Wickham, François, et al. (2020) Wickham (2020) Wickham, Chang, et al. (2020) Greg Freedman Ellis and Derek Burk (2020) Sievert et al. (2020)
Fox, John, Sanford Weisberg, and Brad Price. 2020. Car: Companion to Applied Regression. https://CRAN.R-project.org/package=car.
Greg Freedman Ellis, and Derek Burk. 2020. Ipumsr: Read ’Ipums’ Extract Files. https://CRAN.R-project.org/package=ipumsr.
Sievert, Carson, Chris Parmer, Toby Hocking, Scott Chamberlain, Karthik Ram, Marianne Corvellec, and Pedro Despouy. 2020. Plotly: Create Interactive Web Graphics via ’Plotly.js’. https://CRAN.R-project.org/package=plotly.
Wickham, Hadley. 2020. Forcats: Tools for Working with Categorical Variables (Factors). https://CRAN.R-project.org/package=forcats.
Wickham, Hadley, Winston Chang, Lionel Henry, Thomas Lin Pedersen, Kohske Takahashi, Claus Wilke, Kara Woo, Hiroaki Yutani, and Dewey Dunnington. 2020. Ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics. https://CRAN.R-project.org/package=ggplot2.
Wickham, Hadley, Romain François, Lionel Henry, and Kirill Müller. 2020. Dplyr: A Grammar of Data Manipulation. https://CRAN.R-project.org/package=dplyr.